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/// Forever !!! 



t Apple /// Computer Information 



Compiled by 
David T. Craig 
736 Edgewater, Wichita, Kansas 67230 




Section: Rpple /// [131 Contributes 71076,1173 Size: 7552 

Submitted: 4/14/85 File Type: Binary Access Count: 80 

Title: / Conway's game of Life in Basic'N 
Keys: ^-GRfiPHICS GRME JEPPSON BflSIC 



Conway's game as adapted by C. Hood. Written in Basic. There was an 
associated article in SOFTRLK by Jeppson. The program uas obtained by 
permission and is release to MRUG by permission of the SOURCE Rpple /// SIG 
to preserve the Apple /// data base - E. Raba 



3U$?/U£$S> f?>AS/c 



10 REM C0M4RVS LIFE GAME. From an article in the June "82 issue of Softalk 

15 REM Magazine by Dr. John Jeppson entitled "Counting Hith Colors on the 

20 REM Apple III" (p. 170). Used with permission from Softalk Magazine. 

25 REM Program adapted for The Apple /// Users Group by Charlie, TCK889. 

30 REM Members are urged to read the article in order to get the full back- 

35 REM ground on this BUSINESS BASIC program. (Check pathname, line «240) 
40 

45 REM MAIN PROGRAM - - (8/23/82) 

50 GOSUB 200: REM initial ize 

60 GOSUB 400: REM first generation 

70 GOSUB 600: REM fix colors 

80 ON KBD GOTO 120 

90 count=count+1: GOSUB 1000: REM (begin loop) calculate next generation 

100 GOSUB 1200: GOTO 90: REM show next generation 

110 

120 IF KBD=27 THEN 170 

130 IF KBD=82 OR KBD=114 THEN PERFORM ini tgr a fix:TEXT: HOME: GOSUB 270: GOTO 60 
140 IF KBD=?2 OR KBD=104 THEN PERFORM ini tgrafix: TEXT: HOME: GOSUB 260: GOTO 60 

150 GET Y$:0N KBD GOTO 120 

160 RETURN 

170 FOR i=1 TO 3: PERFORM re lease: NEXT: TEXT: HOME : PRIMT"Qu i t" : END 
180 

190 REM - - (start) initialize - - 

200 lef tedge=2:REM constants chosen for max number of whole cells 

210 rightedge* 136: REM each cell is 2X4 dots 

220 bottomedge=5:REM y-coord. are odd because they are "top" of 

230 topedge=189:REM 2-dot counter 0,1; 2,3; etc. 

240 INU0KE".prof i le/inv/bgraf . inv":REM use appropriate pathname !!! 

250 DIM picU( 12):REM the % is essential; it indicates integer arra^ 

260 GOSUB 2000: REM display instructions, menu, and generation count 

270 GOSUB 2200: REM make image 

275 count =0 

280 oldleft=leftedge 

290 oldright=rightedge 



« Apple /// Computer Info: (LiFE.BAS) Game of Life in /// BASIC 1 



.81 .PICT" 213 KB 2001-08-13 dpi: 300h x 300v pix: 2130h x 3095v 



Source: David T. Craig 



Page 0002 of 0005 



f 

Apple III Computer Information • Doc #108 • Business BASIC Program: Game of Life 



/// Forever !!! 



300 o I dboHon=botto*edge 

310 oldtop=topedge 

320 PERFORM graf ix»ode(83,ft1 ):REM color 140X192, buffer 1 

330 PERFORM f i 1 1 port 

340 PERFORM graf ixon 

350 RETURN 

360 

370 REM — (start) first generation 

400 GOSUB 2400: REM reset window 

405 PERFORM move to ( Unew I e ft , Snew top ) : REM starting position 

410 GOSUB 500: REM get pattern 

415 GOSUB 2600: REM update window 

420 RETURN 

499 REM subroutine getpattern 

500 x= EXFN*.xloc:y= EXFMU.yloc 

505 PERFORM dotaUftx, By+ 1 ) : REM cursor "floats" just above counter 

510 GET g$ 

515 PERFORM pencolor(«):REM black 

520 PERFORM dotat(Sx,Xy+1 ):REM remove cursor 

525 PERFORM penco lor <* 15 >: REM white 

530 PERFORM »oveto(ftx,fty ) 

535 IF RSC(g$>=2? THEN 170 

540 IF RSC<g$)=8 THEN If x>leftedge THEN PERFORM movere K*-2, SO ) 

545 IF RSC(g$)=10 THEM IF y>bottomedge THEN PERFORM movere! (*0,*-4) 

550 IF RSC(g$>=11 THEN IF yUopedge THEN PERFORM moverel (*0,*4) 

555 IF RSC<g$)=21 THEM IF x<rightedge THEM PERFORM moverel (*2,»0> 

560 IF g$=" " THEN PERFORM drcwi»cige(Spic*<0),*2,»0,!l2,*2,ll2):REH zap it 

555 IF g$="x" OR g$="X" THEN PERFORM drawiiiwo^(^ic*(0),S2,*0,*0,S2,!l2):G0SU 

B 2800: REM plot counter and expand window 

570 IF g$="a" OR g$="fl" THEN RETURN: ELSE GOTO 500 
598 

599 REM — (start) fix colors 

600 FOR co 1=0 TO 15: PERFORM setctab(*0,*col ,*col >:NEXT col : REM neuter black 
610 FOR co 1=0 TO 3: PERFORM setctab(*9, *co I , *<eo ! + 1 > ) : h£XT col : REM 'count-up' 
620 FOR col=12 TO 15: PERFORM setctab(K9,*col,*(col-l)):NEXT col : REM 'down' 
630 PERFORM setctab(*9,»4,*4):REM stop counting up 

640 PERFORM setctab(*9,*1 1, ft 11 ):REM stop counting down 

650 FOR col=0 TO 15 

660 PERFORM setctab(*15,*col ,«0):REM white clears screen - - except 

670 IF co I =3 OR col=12 OR col=13 THEN PERFORM setctab(»15,*col,*15) 

690 NEXT co I: REM These have right no. of 'influences' for next generation 

700 RETURN 

998 

999 REM (start) calculate next generation 

1000 GOSUB 2400: REM reset window 

1010 PERFORM pencolor(!l9):REM orange, an influential color 

1015 ON ERR IF ERR=12 THEN RUM: ELSE PRINT-ERROR " ERR", LINE " ERRLIN:END 

1017 REM Handles stack error if <H> or <R> used too many consecutive tines 

1020 FOR x=oldleft TO oldright STEP 2 

1030 FOR y=oldbottom TO oldtop STEP 4 

1040 PERFORM moveto(ftx,*y> 

1050 IF EXFNft.xycolorMO THEN GOSUB 2800 : PERFORM «overel(»-2,»4): PERFORM 

draw i mage(Pp i cRCO ), R2, *Q, *0, *6, ft 12 ) 

1060 NEXT y,x:0FF ERR 

1070 REM (Above) Expand window, plot stamp 

1080 GOSUB 2600: REM update window 

1090 RETURN 
1198 

1199 REM — (start) show next generation — 

1200 PERFORM viewportdteldlef t,«oldright,»oldbotto^-1,*oldtop> 
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1210 


REM oldbottow is the "top" dot of two-dot center 




1220 


PERFORM fillcolor(*15):REM white 




1230 


PERFORM fillport 




1240 


PERFORM fillcolor<X0):REM block 




1250 


PERFORM viewport(S0,S200,S0,l(200) 




1260 


RETURN 




1998 






1999 


REM — (start) insruct ion menu — 




2000 


TEXT: HOME :UP0S=3 




2010 


PRIMTXONWRY'S LIFE GRME (Last count=" count" )" 




2015 


REM 'Last count' is count of generations in prior run when <H> pressed 




2020 






2030 


uP0S=6:PRINT"Use arrow keys and 'X' to draw pattern when dot appears:" 




2040 


PRINT 




2050 


PRIHT"< Arrow > moves special cursor dot in any direction 




2060 


PRINT"< X > deposits a counter to mark pattern 




2070 


PRINT"< SPC > clears a counter" 




2080 


PRIMT"< fl > accepts pattern and starts run 




2090 


PRINT"< ESC > auits program" : PR INT 




2100 


PRINT"Whi le the LIFE prograw is running, you can hit - " : PR 1 NT 




2110 


PRIMT"< Rny Key > to halt or restart display" 




2120 


PRINT"< ESC > to quit 




2130 


PRINT"< R > to Repeat prograw - start a new pattern WITHOUT this menu" 




2140 


PRINT"< H > to review this HELP menu before starting new pattern" 




2150 


PR INT: PRINT: PR INT" - - any key to continue - - < ESC > to quit" 




2160 


GET g$: IF g$=CHR$(27> THEN 170 




2170 


RETURN 




2198 






2199 


REM (start) wake image 




2200 


REM 




2205 


pic*(0)=TEN("fl800"> 




2210 


pic»(1)=TEN("R800"):REH see page 314, Business Basic Manual 




2215 


pic*(2)=TEN("0000"):REM "Creating and Storing a Bit Rrray" 




2220 


pic*(3)=TEN("0000") 




2225 


pic*(4)=TEN( "8800"): REM creates an open square " image" thus: 




2230 


pic*(5>-TEN("8800"> 




2235 


pic*(6)=TEN(-0000"):RO1 * * * 




2240 


p i c*(7 >=TEN( "0000 " ) : REM * * 




2245 


pic*(8)=TEN("R800"):REM * * * 




2250 


pic*(9)=TEN("fl800") 




2255 


pic*(10)=TEN("Q000"):REM "corner of image (one counter also used) 




2250 


pic»( 11)=TEN( "0000" >: REM when placing initial pattern 




2265 


RETURN 




2398 


: : 




2399 


REM — (start) reset window — 




2400 


newleft=CONU*((oldleft+olarighO/2):REM begin "new window" ctr-.of old 




2410 


REM "average" position way fall "between" proper cell positions 




2420 


newr i ght=new 1 ef t+2 




2430 


newbot to*=C0NU*( (o 1 dbo tto+o 1 d top )/2 > 




2440 


IF C0NU&<newbottoffl-1> MOD 4<>0 THEN newbot tow=newbotto»-2 




2450 


new top=newbo t to»+4 






RETURN 




2598 






2509 


REM (start) update window 




2600 


oldleft=newleft-2 




2605 


IF oldleftOeftedge THEN oldleft=leftedge 




2610 


o 1 dr i gh t=newr i gh t+2 




2815 


IF oldrighUrightedge THEN oldright=rightedge 




2620 


o 1 dbotton=newbotton-4 




2625 


IF oldbotton<bottonedge THEN oldbotto»=botto»edge 
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2630 oldtop=newtop+4 

2635 IF oldtopHopedge THEM oldtop=topedge 

2640 RETURH 

2798 

2799 REM — <start) expand window — 

2800 IF x<ne»left THEM newleft=x 
2805 IF x>newright THEN newright=x 
2810 IF y<newbotto» THEN newboUoa=y 
2815 IF y>newtop THEN newtop=y 
2820 RETURN 



End of Document 
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